Option Explicit
Private Const WS_VERSION_REQD = &H101
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1
Private Const SOCKET_ERROR = -1
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128

Private Type HOSTENT
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLength As Integer
    hAddrList As Long
End Type

Private Type WSADATA
    wversion As Integer
    wHighVersion As Integer
    szDescription(0 To WSADescription_Len) As Byte
    szSystemStatus(0 To WSASYS_Status_Len) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpszVendorInfo As Long
End Type

Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long

Private Declare Function WSAStartup Lib "WSOCK32.DLL" ( _
    ByVal wVersionRequired As Long, _
    lpWSAData As WSADATA) As Long
   
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

Private Declare Function gethostname Lib "WSOCK32.DLL" ( _
    ByVal hostname As String, _
    ByVal HostLen As Long) As Long
   
Private Declare Function gethostbyname Lib "WSOCK32.DLL" ( _
    ByVal hostname As String) As Long
   
Private Declare Sub RtlMoveMemory Lib "KERNEL32" ( _
    hpvDest As Any, _
    ByVal hpvSource As Long, _
    ByVal cbCopy As Long)

Private Function hibyte(ByVal wParam As Integer)
    hibyte = wParam \ &H100 And &HFF&
End Function

Private Function lobyte(ByVal wParam As Integer)
    lobyte = wParam And &HFF&
End Function

Private Sub Form_Load()
    Label1.Move 120, 120, 2535, 255
    Label2.Move 1920, 600, 2535, 255
    Command1.Move 120, 600, 1575, 475
    Command2.Move 120, 1200, 1575, 475
    Command3.Move 120, 1800, 1575, 475
    Form1.Height = 2850
    Form1.Width = 4080
    Label1.Caption = "Host IP: " & GetHostIP
    Label2.Caption = GetWinsockState
    SocketsInitialize
    Command1.Caption = "Listen"
    Command2.Caption = "Send Data"
    Command3.Caption = "Close Connections"
    Command2.Enabled = False
    Command3.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SocketsCleanup
End Sub

Private Sub Command1_Click()
    Winsock1.Protocol = sckTCPProtocol
    Winsock1.LocalPort = 5149
    Winsock1.RemotePort = 5150
    Winsock1.Listen
    Label2.Caption = GetWinsockState
    Command1.Enabled = False
    MsgBox "Go hit ""Connect"" button on device"
End Sub

Private Sub Command2_Click()
    Dim sFileName As String
    Dim lOffset As Long
    Dim bTemp As Byte
    Dim bFileData() As Byte
    Dim lLength As Long
    
    'NOTE: BMP must be 256 color or less.
    sFileName = "d:\mnu.bmp"
    
    Open sFileName For Binary Access Read As #1
    ReDim bFileData(FileLen(sFileName))
    lLength = FileLen(sFileName) + 1
    
    For lOffset = 1 To lLength
        If Not lOffset = lLength Then
            Get #1, lOffset, bTemp
            bFileData(lOffset - 1) = bTemp
        Else
            bFileData(lOffset - 1) = CByte(26)
        End If
    Next lOffset
    
    Close #1
    
    Winsock2.SendData bFileData()
    
    Command2.Enabled = False
    Command3.Enabled = True
End Sub

Private Sub Command3_Click()
    Winsock1.Close
    Winsock2.Close
    Label2.Caption = GetWinsockState
    Command1.Enabled = True
    Command2.Enabled = False
    Command3.Enabled = False
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
    Winsock2.Accept requestID
    Command2.Enabled = True
    Label2.Caption = "Listening: Connected"
End Sub

Private Sub SocketsInitialize()
    Dim WSAD As WSADATA
    Dim iReturn As Integer
    Dim sLowByte As String, sHighByte As String, sMsg As String
    
    iReturn = WSAStartup(WS_VERSION_REQD, WSAD)
    
    If iReturn <> 0 Then
        MsgBox "Winsock.dll is not responding."
        End
    End If

    If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or _
        (lobyte(WSAD.wversion) = _
        WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
        sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
        sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
        sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte
        sMsg = sMsg & " is not supported by winsock.dll "
        MsgBox sMsg
        End
    End If

    'iMaxSockets is not used in Winsock 2, so the following check is only
    'necessary for Winsock 1. If Winsock 2 is requested,
    'the following check can be skipped.

    If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
        sMsg = "This application requires a minimum of "
        sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
        MsgBox sMsg
        End
    End If

End Sub

Private Function GetWinsockState() As String
    Select Case Winsock1.State
        Case 0 'sckClosed
            GetWinsockState = "Closed"
        Case 1 'sckOpen
            GetWinsockState = "Open"
        Case 2 'sckListening
            GetWinsockState = "Listening"
        Case 3 'sckConnectionPending
            GetWinsockState = "Connection pending"
        Case 4 'sckResolvingHost
            GetWinsockState = "Resolving host"
        Case 5 'sckHostResolved
            GetWinsockState = "Host resolved"
        Case 6 'sckConnecting
            GetWinsockState = "Connecting"
        Case 7 'sckConnected
            GetWinsockState = "Connected"
        Case 8 'sckClosing
            GetWinsockState = "Peer is closing the connection"
        Case 9 'sckError
            GetWinsockState = "Error"
    End Select
End Function

Private Function GetHostIP() As String
    Dim sHostName As String * 256
    Dim lHostEnt_Addr As Long
    Dim Host As HOSTENT
    Dim lHostIP_Addr As Long
    Dim bTempIP_Addr() As Byte
    Dim i As Integer
    Dim sIP_Addr As String
    
    If gethostname(sHostName, 256) = SOCKET_ERROR Then
        MsgBox "Windows Sockets error " & Str(WSAGetLastError())
        Exit Function
    Else
        sHostName = Trim$(sHostName)
    End If
    
    lHostEnt_Addr = gethostbyname(sHostName)
    
    If lHostEnt_Addr = 0 Then
        MsgBox "Winsock.dll is not responding."
        Exit Function
    End If
    
    RtlMoveMemory Host, lHostEnt_Addr, LenB(Host)
    RtlMoveMemory lHostIP_Addr, Host.hAddrList, 4
    
    'Get all of the IP addresses if the computer is multi-homed.
    Do
        ReDim bTempIP_Addr(1 To Host.hLength)
        RtlMoveMemory bTempIP_Addr(1), lHostIP_Addr, Host.hLength
        
        For i = 1 To Host.hLength
            sIP_Addr = sIP_Addr & bTempIP_Addr(i) & "."
        Next
        
        sIP_Addr = Mid$(sIP_Addr, 1, Len(sIP_Addr) - 1)
        GetHostIP = sIP_Addr
        sIP_Addr = ""
        Host.hAddrList = Host.hAddrList + LenB(Host.hAddrList)
        RtlMoveMemory lHostIP_Addr, Host.hAddrList, 4
    Loop While (lHostIP_Addr <> 0)

End Function

Private Sub SocketsCleanup()
    Dim lReturn As Long
    lReturn = WSACleanup()
    If lReturn <> 0 Then
        MsgBox "Socket error " & Trim$(Str$(lReturn)) & _
               " occurred in cleanup."
        End
    End If
End Sub
						

Option Explicit

Dim inBytes() As Variant
Dim MyString As String
Dim bLast As Boolean
Dim bNotFirst As Boolean
Dim hFile As Long

Private Sub Command1_Click()
    WaitCursor True
    Label1.Caption = "Connecting...."
    WinSock1.LocalPort = 5150
    WinSock1.RemotePort = 5149
    WinSock1.RemoteHost = "111.111.111.111" 'Put your IP address here
    WinSock1.Connect
    
    Label1.Caption = "Connected"
    Command1.Enabled = False
    Command2.Enabled = True
    WaitCursor False
End Sub

Private Sub Command2_Click()
    WinSock1.Close
    Command1.Enabled = True
    Command2.Enabled = False
End Sub

Private Sub Form_Load()
    Command1.Move 120, 120, 1335, 495
    Command2.Move 120, 720, 1335, 495
    Label1.Move 1560, 120, 1695, 255
    ImageCtl1.Move 120, 1320, 2775, 1575
    Command1.Caption = "Connect"
    Command2.Caption = "Close Winsock"
    Command2.Enabled = False
    Label1.Caption = ""
End Sub

Private Sub WinSock1_DataArrival(ByVal bytesTotal As Long)
    ReDim inBytes(bytesTotal)
    
    WinSock1.GetData inBytes, (vbByte + vbArray)
    
    If AscB(ChrB(inBytes(UBound(inBytes)))) = 26 Then
        bLast = True
    End If
    
    MakeString
    WriteIt
    
    If bLast Then ImageCtl1.Picture = "\MyFile.bmp"
End Sub

Private Sub MakeString()
    Dim x As Integer
    Dim iEnd As Integer
    
    MyString = ""
    
    If Not bLast Then
        iEnd = UBound(inBytes)
    Else
        iEnd = UBound(inBytes) - 1
    End If
    
    For x = LBound(inBytes) To iEnd
        MyString = MyString & ChrB(inBytes(x))
    Next
End Sub

Private Function WriteIt() As Boolean
    Dim retVal As Long, lWritten As Long
    
    If Not bNotFirst Then
        hFile = CreateFile("MyFile.bmp", GENERIC_READ + GENERIC_WRITE, _
                           0, 0, CREATE_ALWAYS, 0, 0)
        bNotFirst = True
    End If
    
    If hFile <> -1 Then
        retVal = WriteFile(hFile, MyString, LenB(MyString), lWritten, 0)
        If bLast Then retVal = CloseHandle(hFile)
    End If
End Function

Private Sub Form_OKClick()
    App.End
End Sub
						

Option Explicit

Public Declare Function CreateFile Lib "Coredll" Alias "CreateFileW" ( _
    ByVal lpFileName As String, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, _
    lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) As Long

Public Declare Function ReadFile Lib "Coredll" ( _
    ByVal hFile As Long, _
    ByVal lpBuffer As String, _
    ByVal nNumberOfBytesToRead As Long, _
    lpNumberOfBytesRead As Long, _
    ByVal lpOverlapped As Long) As Long

Public Declare Function WriteFile Lib "Coredll" ( _
    ByVal hFile As Long, _
    ByVal lpBuffer As String, _
    ByVal nNumberOfBytesToWrite As Long, _
    lpNumberOfBytesWritten As Long, _
    ByVal lpOverlapped As Long) As Long

Public Declare Function CloseHandle Lib "Coredll" ( _
    ByVal hObject As Long) As Long

Public Declare Function GetLastError Lib "Coredll" () As Long

Public Declare Function LoadCursor Lib "Coredll" _
    Alias "LoadCursorW" ( _
    ByVal hInstance As Long, _
    ByVal lpCursorName As Long) As Long

Public Declare Function SetCursor Lib "Coredll" ( _
    ByVal hCursor As Long) As Long
    
Public Const READ_CONTROL = &H20000
Public Const READ_WRITE = 2
Public Const FILE_READ_DATA = (&H1)
Public Const FILE_READ_ATTRIBUTES = (&H80)
Public Const FILE_READ_EA = (&H8)
Public Const FILE_WRITE_ATTRIBUTES = (&H100)
Public Const FILE_WRITE_DATA = (&H2)
Public Const FILE_WRITE_EA = (&H10)
Public Const FILE_APPEND_DATA = (&H4)
Public Const SYNCHRONIZE = &H100000

Public Const CREATE_ALWAYS = 2
Public Const OPEN_EXISTING = 3
Public Const OPEN_ALWAYS = 4
Public Const STANDARD_RIGHTS_WRITE = &H20000
Public Const STANDARD_RIGHTS_READ = &H20000
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000

Public Const IDC_WAIT = 32514

Public Function WaitCursor(bWait As Boolean) As Long
    Dim hCursor As Long
    
    'Obtain the handle to the cursor.
    If bWait Then
        'Get handle to the wait cursor.
        hCursor = LoadCursor(0, IDC_WAIT)
    Else
        'Restore default cursor.
        hCursor = LoadCursor(0, 0)
    End If
    
    'Set the cursor based on the cursor handle.
    WaitCursor = SetCursor(hCursor)

End Function